home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 2614.ZIP / TBROWS.ZIP / TTBR9.PRG < prev   
Text File  |  1990-10-22  |  4KB  |  181 lines
  1. /*****
  2.  *
  3.  * TTBR9.PRG
  4.  * Nineth example for TBROWSE class using a database file
  5.  *
  6.  * 22 October 90
  7.  * Luiz Quintela - Nantucket Corp
  8.  *
  9.  * Clipper ttbr9 /N/W/A/B
  10.  * RTLINK FILE ttbr9 PLL base50
  11.  *
  12.  */
  13.  
  14. // Include Header Files
  15. #include "inkey.ch"
  16. #include "setcurs.ch"
  17.  
  18. MEMVAR GetList
  19.  
  20. FUNCTION Main()
  21. LOCAL b, column, nKey, aColors, nCnt, aLowHi
  22. SET SCOREBOARD OFF
  23. SET DATE       BRITISH
  24. SET CONFIRM    ON
  25. READEXIT(.T.)
  26.  
  27. USE test INDEX test NEW
  28. // Turn cursor off
  29. SETCURSOR(SC_NONE)
  30. SETCOLOR( "BG/B" ); CLS
  31.  
  32. b := TBrowseDB( 2, 2, 20, 48)
  33. b:colorSpec := "BG/B,GR+/R,W/N,N,GR+/W,N/B,R+/B,GR+/B"
  34.  
  35. b:colSep  := " │ "
  36. b:headSep := "═╤═"
  37. b:footSep := "═══"
  38.  
  39. // TBColumn objects
  40. // Due to the fact that ahead in this example
  41. // we will edit the field, we need to assign a get-set
  42. // block to the object
  43. // In Clipper's old times it was a regular practice
  44. // use of macro operator 
  45. // But now, you can use FIELDBLOCK()
  46. // thus avoiding the overhead in size and speed 
  47. // Be aware of this:
  48. // Do not use FIELDBLOCK("alias->field")
  49. // Use always FIELDBLOCK("field")
  50. // FIELDBLOCK() assumes you are using a field in the current
  51. // work area
  52. // If you need to use a field in another area use FIELDWBLOCK()
  53. //
  54. column := TBColumnNew( "Field 1", FIELDBLOCK("test->fld1") )
  55. column:footing := "First"
  56. b:addColumn( column )
  57. column := TBColumnNew( "Field 2", FIELDBLOCK("fld2") )
  58. b:addColumn( column )
  59. column := TBColumnNew( "Field 3", FIELDBLOCK("fld3") )
  60. b:addColumn( column )
  61. column := TBColumnNew( "Field 4", FIELDBLOCK("fld4") )
  62. b:addColumn( column )
  63. column := TBColumnNew( "Field 5", FIELDBLOCK("fld5") )
  64. column:footing := "Last"
  65. b:addColumn( column )
  66.  
  67. // Freeze one column 
  68. b:freeze := 1
  69.  
  70. WHILE .T.
  71.    IF  ( b:colPos <= 1 )
  72.        b:colPos := b:freeze + 1
  73.  
  74.    ENDIF
  75.  
  76.    // Stabilization
  77.    WHILE ( !b:stabilize() )
  78.       nKey := InKey()
  79.       IF ( nKey != 0 )
  80.          EXIT // abort if a key is waiting
  81.  
  82.       ENDIF
  83.  
  84.    END
  85.  
  86.    IF ( b:stable )
  87.       IF ( b:hitTop .OR. b:hitBottom )
  88.           TONE(87.3,1)
  89.          TONE(40,3.5)
  90.  
  91.       ENDIF
  92.       nKey := INKEY(0)         
  93.  
  94.    ENDIF
  95.  
  96.    // Process key
  97.     IF ( nKey == K_DOWN )
  98.       b:down()
  99.  
  100.    ELSEIF ( nKey == K_UP )
  101.       b:up()
  102.  
  103.    ELSEIF ( nKey == K_PGDN )
  104.       b:pageDown()
  105.  
  106.    ELSEIF ( nKey == K_PGUP )
  107.       b:pageUp()
  108.  
  109.    ELSEIF ( nKey == K_CTRL_PGUP )
  110.       b:goTop()
  111.  
  112.    ELSEIF ( nKey == K_CTRL_PGDN )
  113.       b:goBottom()
  114.  
  115.    ELSEIF ( nKey == K_RIGHT )
  116.       b:right()
  117.  
  118.    ELSEIF ( nKey == K_LEFT )
  119.       b:left()
  120.  
  121.    ELSEIF ( nKey == K_HOME )
  122.       b:home()
  123.  
  124.    ELSEIF ( nKey == K_END )
  125.       b:end()
  126.  
  127.    ELSEIF ( nKey == K_CTRL_LEFT )
  128.       b:panLeft()
  129.  
  130.    ELSEIF ( nKey == K_CTRL_RIGHT )
  131.       b:panRight()
  132.  
  133.    ELSEIF ( nKey == K_CTRL_HOME )
  134.       b:panHome()
  135.  
  136.    ELSEIF ( nKey == K_CTRL_END )
  137.       b:panEnd()
  138.  
  139.    ELSEIF ( nKey == K_ESC )
  140.         CLS; SETCURSOR(SC_NORMAL); QUIT
  141.  
  142.    ELSEIF ( nKey == K_ENTER )
  143.        DoGet( b )
  144.  
  145.     ENDIF
  146.  
  147. END
  148.  
  149. FUNCTION DoGet( b )
  150. LOCAL nCursSave
  151. LOCAL column, get, nKey
  152.  
  153. nCursSave := SETCURSOR(SC_NORMAL)
  154.  
  155. // make sure browse is stable
  156. WHILE ( !b:stabilize() ); END
  157.  
  158. // get column object from browse
  159. column := b:getColumn( b:colPos )
  160.  
  161. // create a corresponding GET
  162. get := GetNew( ROW(), COL(), column:block, column:heading,, b:colorSpec)
  163.  
  164. //read it
  165. READMODAL( {get} )
  166.  
  167. // force redisplay of current row
  168. b:refreshCurrent()
  169.  
  170. // check exit key */
  171. nKey := LASTKEY()
  172. IF ( nKey == K_UP .OR. nKey == K_DOWN .OR. ;
  173.      nKey == K_PGUP .OR. nKey == K_PGDN )
  174.      KEYBOARD CHR( nKey )
  175.  
  176. ENDIF
  177. SETCURSOR(SC_NONE)
  178. RETURN NIL
  179.  
  180. /* EOF - TBBR9.PRG */
  181.